home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / cli / mx2src.arc / XMODEM.MOD < prev    next >
Text File  |  1989-01-05  |  20KB  |  608 lines
  1.  
  2. (*              Copyright 1987 fred brooks LogicTek             *)
  3. (*                                                              *)
  4. (*                                                              *)
  5. (*   First Release                      12/8/87-FGB             *)
  6. (*   Minor fixups                       3/7/88-FGB              *)
  7. (*                                                              *)
  8.  
  9. (*$T-,$S-,$A+ *)
  10. (* This version of xmodem has been written using UNIX and the sealink
  11.    C programming versions as examples. Many thanks to those who have done
  12.    this before me.        Fred Brooks                                   *)
  13.  
  14. IMPLEMENTATION MODULE XMODEM;
  15. FROM SYSTEM     IMPORT ADDRESS, CODE, REGISTER, SETREG, ADR, WORD;
  16. FROM GEMX       IMPORT BasePageAddress, BasePageType ;
  17. FROM BIOS       IMPORT BConStat, BCosStat, BConIn, BConOut, Device;
  18. FROM XBIOS      IMPORT SuperExec;
  19. FROM GEMDOS     IMPORT Create, Open, Close, Write, Read, GetDTA, SFirst;
  20. FROM TextIO     IMPORT WriteString, WriteLn, WriteInt,  WriteAdr;
  21. FROM BitStuff   IMPORT WAnd, WEor, WShl, WShr;
  22. FROM Strings    IMPORT String, Assign;
  23.  
  24. TYPE            CharPtr       =          POINTER TO ARRAY [0..MAX(LONGINT)] OF CHAR;
  25.  
  26. CONST           SECSIZ        =          80H;
  27.                 BUFSIZ        =          200H;
  28.                 ERRORMAX      =          20;
  29.                 RETRYMAX      =          20;
  30.                 SOH           =          1c;
  31.                 EOT           =          4c;
  32.                 ACK           =          6c;
  33.                 NAK           =          25c;
  34.                 C             =          103c;
  35.                 RTS           =          4e75H;
  36.                 BELL          =          7c;
  37.                 CTRLZ         =          32c;
  38.  
  39. VAR             result,mtimeout         :       INTEGER;
  40.                 filename                :       String;
  41.                 hz200 [04baH]           :       LONGCARD;
  42.                 t1,prtime               :       LONGCARD;
  43.                 readchar                :       CHAR;
  44.                 filesize                :       POINTER TO LONGCARD;
  45.                 snd,rec,ok              :       BOOLEAN;
  46.  
  47. (*$P- *)
  48. PROCEDURE       rdtime();       (* read 200hz clock *)
  49. BEGIN
  50.         prtime:=hz200;
  51.         CODE(RTS);
  52. END             rdtime;
  53. (*$P+ *)
  54.  
  55. PROCEDURE       GetTime(): LONGCARD;
  56. BEGIN
  57.         SuperExec(rdtime);
  58.         RETURN prtime;
  59. END             GetTime;
  60.  
  61. PROCEDURE       timerset(time: INTEGER): LONGCARD;
  62. BEGIN
  63.         RETURN (LONGCARD(time)+(GetTime() DIV 20));
  64. END             timerset;
  65.  
  66. PROCEDURE       timeup(timer: LONGCARD): BOOLEAN;
  67. BEGIN
  68.         IF ((GetTime() DIV 20)>timer) OR ((GetTime() DIV 20)=timer) THEN
  69.            RETURN TRUE;
  70.         ELSE
  71.            RETURN FALSE;
  72.         END;
  73. END             timeup;
  74.  
  75. PROCEDURE       errorbells;
  76. VAR             i,delay        :       CARDINAL;
  77. BEGIN
  78.            FOR i:=0 TO 3 DO
  79.                FOR delay:=0 TO 10000 DO END;
  80.                BConOut(CON,BELL);
  81.            END;
  82. END             errorbells;
  83.  
  84. PROCEDURE       crcupdate(crcvalue: CARDINAL; data: CHAR): CARDINAL;
  85. CONST           GEN1X5X12X16                  =     1021H;
  86. VAR             i,xin,cha                     :     INTEGER;
  87.                 t                             :     CARDINAL;
  88. BEGIN
  89.         cha:=INTEGER(data);
  90.         FOR i:=0 TO 7 DO
  91.             xin:=INTEGER(WAnd(crcvalue,8000H));
  92.             cha:=INTEGER(WShl(cha,1));
  93.             IF INTEGER(WAnd(cha,100H))#0 THEN
  94.                t:=crcvalue;
  95.                crcvalue:=1+CARDINAL(WShl(t,1));
  96.             ELSE
  97.                t:=crcvalue;
  98.                crcvalue:=0+CARDINAL(WShl(t,1));
  99.             END;
  100.             IF xin#0 THEN 
  101.                crcvalue:=CARDINAL(WEor(crcvalue,GEN1X5X12X16));
  102.             END;
  103.         END;
  104.         RETURN crcvalue;
  105. END             crcupdate;
  106.  
  107. PROCEDURE       crcfinish(crcvalue: CARDINAL): CARDINAL;
  108. BEGIN
  109.         RETURN CARDINAL(WAnd(crcupdate(crcupdate(crcvalue,0c),0c),0ffffH));
  110.  
  111.  
  112. END             crcfinish;
  113.  
  114. PROCEDURE       IAnd255(num: INTEGER): INTEGER;
  115. BEGIN
  116.         RETURN INTEGER(WAnd(num,0ffH));
  117. END             IAnd255;
  118.  
  119. PROCEDURE       mdmini;
  120. BEGIN
  121.         ok:=FALSE;
  122.         xmodemerror:=0;
  123.         xmodemabort:=FALSE;
  124.         mtimeout:=120;
  125.         mdmBytesXferred:=0;
  126.         mdmPacketsSent:=0;
  127.         mdmPacketsReceived:=0;
  128.         mdmBadPackets:=0;
  129.         mdmNakedPackets:=0;
  130. END             mdmini;
  131.  
  132. PROCEDURE       xmodemstat;
  133. BEGIN
  134.         WriteLn;
  135.         WriteString("      XMODEM STATUS       ");
  136.         IF rec THEN 
  137.            WriteString(" receiver active       ");
  138.            WriteString(xfrname);
  139.            IF crcmode THEN
  140.               WriteString(" CRC mode.");
  141.            ELSE
  142.               WriteString(" CHECKSUM mode.");
  143.            END;
  144.         END;
  145.         IF snd THEN 
  146.            WriteString(" transmitter active    "); 
  147.            WriteString(xfrname);
  148.            IF crcmode THEN
  149.               WriteString(" CRC mode.");
  150.            ELSE
  151.               WriteString(" CHECKSUM mode.");
  152.            END;
  153.         END;
  154.         WriteLn;
  155.         IF ok THEN
  156.            WriteString("       Transfer complete.  ");
  157.            WriteLn;
  158.         END;
  159.         IF xmodemerror#0 THEN
  160.            WriteString("       Transfer aborted!  ");
  161.            errorbells;
  162.            WriteLn;
  163.         END;
  164.         WriteLn;
  165.         WriteString(" Total packets sent  ");
  166.         WriteInt(mdmPacketsSent,12);
  167.         WriteLn;
  168.         WriteString(" Packets left        ");
  169.         WriteInt(endblk,12);
  170.         WriteLn;
  171.         WriteString(" Packets received    ");
  172.         WriteInt(mdmPacketsReceived,12);
  173.         WriteLn;
  174.         WriteString(" Bad packets         ");
  175.         WriteInt(mdmBadPackets,12);
  176.         WriteLn;
  177.         WriteString(" Naked packets sent  ");
  178.         WriteInt(mdmNakedPackets,12);
  179.         WriteLn;
  180.         WriteString(" Bytes transferred   ");
  181.         WriteAdr(ADDRESS(mdmBytesXferred),12);
  182.         WriteLn;
  183. END             xmodemstat;
  184.  
  185. PROCEDURE       setbuffer(char: CharPtr; length: CARDINAL; value: CHAR);
  186. VAR             data            :        POINTER TO CHAR;
  187. BEGIN
  188.         WHILE length#0 DO
  189.               data:=ADDRESS(char);
  190.               data^:=value;
  191.               INC(char);
  192.               DEC(length);
  193.         END;
  194. END             setbuffer;
  195.  
  196. PROCEDURE       writeModem(char: CharPtr; count: LONGCARD);
  197. VAR             data             :        POINTER TO CHAR;
  198. BEGIN
  199.         WHILE count#0 DO
  200.               DEC(count);
  201.               data:=ADDRESS(char);
  202.               INC(char);
  203.  
  204.               sendchar(data^);
  205.         END;
  206. END             writeModem;
  207.  
  208. PROCEDURE       readModem(VAR char: CHAR; time: INTEGER);
  209. VAR             data         :  CHAR;
  210.                 longchar     :  LONGCARD;
  211.                 t            :  BITSET;
  212.                 WaitTime     :  LONGCARD;
  213.                 ticks        :  CARDINAL;
  214. BEGIN
  215.         IF time=0 THEN
  216.            IF BConStat(AUX) THEN (* return char *)
  217.               longchar:=BConIn(AUX);
  218.               t:=BITSET(longchar);
  219.               EXCL(t,8);
  220.               char:=CHAR(t);
  221.               RETURN; 
  222.            ELSE
  223.               char:=CHAR(255);
  224.               RETURN;
  225.            END;
  226.         END;
  227.  
  228.         WaitTime:=LONGCARD(time)+(GetTime() DIV 20);
  229.         ticks:=0;
  230.         LOOP
  231.                 IF BConStat(AUX) THEN
  232.                    longchar:=BConIn(AUX);
  233.                    t:=BITSET(longchar);
  234.                    EXCL(t,8);
  235.                    char:=CHAR(t);
  236.                    RETURN;
  237.                 END;
  238.         IF ((GetTime() DIV 20)>WaitTime) 
  239.         OR ((GetTime() DIV 20)=WaitTime) THEN
  240.            INC(ticks);
  241.            WaitTime:=LONGCARD(time)+(GetTime() DIV 20);
  242.            IF ticks=2 THEN
  243.               char:=CHAR(255);
  244.               RETURN;
  245.            END;
  246.         END;
  247.         END; (* loop *)
  248. END             readModem;
  249.  
  250. PROCEDURE       flushinput();
  251. VAR             char    :       LONGCARD;
  252. BEGIN
  253.         WHILE BConStat(AUX) DO
  254.               char:=BConIn(AUX);
  255.         END;
  256. END             flushinput;
  257.  
  258. PROCEDURE       sendchar(char: CHAR);
  259. BEGIN
  260.         BConOut(AUX,char);
  261. END             sendchar;
  262.  
  263. PROCEDURE       xmodemrec(filename: ARRAY OF CHAR): BOOLEAN;
  264. VAR             sectnum,s